home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO002.dsk / SURVEY.bas < prev    next >
BASIC Source File  |  2012-02-16  |  7KB  |  266 lines
  1. 10 D$ =  CHR$(4): PRINT D$;"PR#3"
  2. 20  TEXT 
  3. 30 V = 1: GOSUB 40:V = 24: GOSUB 40: GOTO 60
  4. 40  VTAB (V): HTAB (1): FOR X = 1 TO 79: PRINT "_";: NEXT 
  5. 50  RETURN 
  6. 60  VTAB (5): HTAB (27)
  7. 70  PRINT "[ THIS PROGRAM IS FREEWARE ]"
  8. 80  PRINT : PRINT : HTAB (24)
  9. 90  PRINT "YOU ARE FREE TO DISTRIBUTE COPIES"
  10. 100  PRINT : HTAB (28)
  11. 110  PRINT "BUT YOU MAY NOT SELL THEM."
  12. 120  VTAB (18): HTAB (31)
  13. 130  PRINT "THE FREEWARE PROJECT"
  14. 140  PRINT : HTAB (31)
  15. 150  PRINT "WALDEN SOFTWARE, INC."
  16. 160  PRINT : HTAB (32)
  17. 170  PRINT "(C) 1984, P. LUTUS"
  18. 180  FOR PAUSE = 0 TO 2500: NEXT 
  19. 190 D$ =  CHR$(4)
  20. 200 HT = 1403
  21. 210 F = 57.29577951
  22. 220  PRINT D$;"PR#3"
  23. 230  DIM Q(40): DIM D(40): DIM M(40): DIM S(40): DIM L(40)
  24. 240  DIM Q$(4)
  25. 250  FOR X = 1 TO 4
  26. 260  READ Q$(X): NEXT 
  27. 270  DATA  "NE","SE","SW","NW"
  28. 280 TP = 1
  29. 290  TEXT : PRINT  CHR$(12);
  30. 300  GOSUB 420: PRINT 
  31. 310  PRINT "E)nter P)lot A)djust I)nsert D)elete C)hange N)ew L)oad S)ave Q)uit:";
  32. 320  GET L$
  33. 330  GOSUB 370
  34. 340  PRINT L$
  35. 350  GOSUB 540
  36. 360  GOTO 290
  37. 370  IF L$ = ""  THEN  RETURN 
  38. 380 L =  ASC(L$)
  39. 390  IF L >95  THEN L = L -32
  40. 400 L$ =  CHR$(L)
  41. 410  RETURN 
  42. 420  IF TP >1  THEN 440
  43. 430  PRINT "(no survey entries)": RETURN 
  44. 440  PRINT "#   Quadrant  Degrees  Minutes  Seconds  Feet"
  45. 450  PRINT 
  46. 460  FOR X = 1 TO TP -1
  47. 470  PRINT X;
  48. 480  POKE HT,4: PRINT Q$(Q(X));
  49. 490  POKE HT,14: PRINT D(X);
  50. 500  POKE HT,23: PRINT M(X);
  51. 510  POKE HT,32: PRINT S(X);
  52. 520  POKE HT,41: PRINT L(X)
  53. 530  NEXT : RETURN 
  54. 540  IF L$ < >"A"  THEN PL = 0
  55. 550  IF L$ = "E"  THEN 660
  56. 560  IF L$ = "I"  THEN 1010
  57. 570  IF L$ = "D"  THEN 1150
  58. 580  IF L$ = "C"  THEN 1240
  59. 590  IF L$ = "S"  THEN 1290
  60. 600  IF L$ = "L"  THEN 1530
  61. 610  IF L$ = "Q"  THEN 1800
  62. 620  IF L$ = "N"  THEN 1870
  63. 630  IF L$ = "P"  THEN 1910
  64. 640  IF L$ = "A"  THEN 2470
  65. 650  RETURN 
  66. 660  HOME : GOSUB 420
  67. 670 P = TP: GOSUB 700
  68. 680  IF V  THEN TP = TP +1: GOTO 660
  69. 690  RETURN 
  70. 700 V = 0
  71. 710  IF DL  THEN 770
  72. 720  PRINT 
  73. 730  PRINT "Entry ";P
  74. 740  PRINT 
  75. 750  PRINT "Quadrant (NE,SE,SW,NW):";
  76. 760 H =  PEEK(HT): PRINT Q$(Q(P));: POKE HT,H
  77. 770  GOSUB 980
  78. 780  IF L$ = ""  THEN  RETURN 
  79. 790 X = 1
  80. 800  IF L$ = Q$(X)  THEN 830
  81. 810 X = X +1: IF X <5  THEN 800
  82. 820  GOTO 740
  83. 830 Q(P) = X
  84. 840 Q$ = "Degrees:":Q = D(P): GOSUB 950
  85. 850  IF L$ = ""  THEN  RETURN 
  86. 860 D(P) =  VAL(L$)
  87. 870 Q$ = "Minutes:":Q = M(P): GOSUB 950
  88. 880 M(P) =  VAL(L$)
  89. 890 Q$ = "Seconds:":Q = S(P): GOSUB 950
  90. 900 S(P) =  VAL(L$)
  91. 910 Q$ = "Length in feet:":Q = L(P): GOSUB 950
  92. 920  IF L$ = ""  THEN  RETURN 
  93. 930 L(P) =  VAL(L$)
  94. 940 V = 1: RETURN 
  95. 950  IF DL  THEN 980
  96. 960  PRINT Q$;:H =  PEEK(HT)
  97. 970  PRINT Q;: POKE HT,H
  98. 980  INPUT "";L$
  99. 990  IF  RIGHT$(L$,1) = " "  THEN L$ =  LEFT$(L$,( LEN(L$) -1)): GOTO 990
  100. 1000  RETURN 
  101. 1010  PRINT : INPUT "Insert Line:";L$
  102. 1020  IF L$ = ""  THEN  RETURN 
  103. 1030 P =  VAL(L$)
  104. 1040  IF P <1  OR P >TP  THEN  RETURN 
  105. 1050  GOSUB 1090
  106. 1060  GOSUB 700
  107. 1070  IF   NOT V  THEN 1190
  108. 1080  RETURN 
  109. 1090  REM  BUMP UP
  110. 1100  FOR X = TP TO P  STEP  -1
  111. 1110 Y = X +1
  112. 1120 Q(Y) = Q(X):D(Y) = D(X):M(Y) = M(X)
  113. 1130 S(Y) = S(X):L(Y) = L(X)
  114. 1140  NEXT :TP = TP +1: RETURN 
  115. 1150  PRINT : INPUT "Delete Line:";L$
  116. 1160  IF L$ = ""  THEN  RETURN 
  117. 1170 P =  VAL(L$)
  118. 1180  IF P <1  OR P >(TP -1)  THEN  RETURN 
  119. 1190  FOR X = P TO TP
  120. 1200 Y = X +1
  121. 1210 Q(X) = Q(Y):D(X) = D(Y):M(X) = M(Y)
  122. 1220 S(X) = S(Y):L(X) = L(Y)
  123. 1230  NEXT :TP = TP -1: RETURN 
  124. 1240  PRINT : INPUT "Change Line:";L$
  125. 1250  IF L$ = ""  THEN  RETURN 
  126. 1260 P =  VAL(L$)
  127. 1270  IF P <1  OR P >(TP -1)  THEN  RETURN 
  128. 1280  GOTO 720
  129. 1290  IF TP <2  THEN  RETURN 
  130. 1300  PRINT 
  131. 1310  PRINT "Enter Save File Name (?=Catalog):";
  132. 1320 H =  PEEK(HT): PRINT F$;: POKE HT,H
  133. 1330  INPUT "";L$
  134. 1340  IF L$ = ""  THEN  RETURN 
  135. 1350  IF L$ < >"?"  THEN 1390
  136. 1360  HOME 
  137. 1370  PRINT D$;"CATALOG"
  138. 1380  GOTO 1300
  139. 1390  PRINT 
  140. 1400 F$ = L$
  141. 1410  PRINT D$;"OPEN";F$
  142. 1420  PRINT D$;"WRITE";F$
  143. 1430  FOR X = 1 TO TP -1
  144. 1440  PRINT Q$(Q(X))
  145. 1450  PRINT D(X)
  146. 1460  PRINT M(X)
  147. 1470  PRINT S(X)
  148. 1480  PRINT L(X)
  149. 1490  NEXT 
  150. 1500  PRINT : PRINT 
  151. 1510  PRINT D$;"CLOSE";F$
  152. 1520  RETURN 
  153. 1530  PRINT 
  154. 1540  IF TP <2  THEN 1590
  155. 1550  INPUT "Erases Existing Entries. OK (Y/N):";L$
  156. 1560  GOSUB 370
  157. 1570  IF L$ < >"Y"  THEN  RETURN 
  158. 1580  PRINT 
  159. 1590  PRINT "Enter Load File Name (?=Catalog):";
  160. 1600 H =  PEEK(HT): PRINT F$;
  161. 1610  POKE HT,H
  162. 1620  INPUT "";L$
  163. 1630  IF L$ = ""  THEN  RETURN 
  164. 1640  IF L$ < >"?"  THEN 1680
  165. 1650  HOME 
  166. 1660  PRINT D$;"CATALOG"
  167. 1670  GOTO 1590
  168. 1680  PRINT 
  169. 1690 F$ = L$
  170. 1700  PRINT D$;"OPEN";F$
  171. 1710  PRINT D$;"READ";F$
  172. 1720 DL = 1
  173. 1730 P = 1
  174. 1740  GOSUB 700
  175. 1750  IF V = 0  THEN 1770
  176. 1760 P = P +1: GOTO 1740
  177. 1770  PRINT D$;"CLOSE";F$
  178. 1780 DL = 0
  179. 1790 TP = P: RETURN 
  180. 1800  PRINT : INPUT "Quit (Y/N):";L$
  181. 1810  GOSUB 370
  182. 1820  IF L$ < >"Y"  THEN  RETURN 
  183. 1830  INPUT "Save Entries (Y/N):";L$
  184. 1840  GOSUB 370
  185. 1850  IF L$ < >"N"  THEN  GOSUB 1290
  186. 1860  TEXT : HOME : PRINT  CHR$(4)"-STARTUP"
  187. 1870  PRINT : INPUT "Erase Entries (Y/N):";L$
  188. 1880  GOSUB 370
  189. 1890  IF L$ = "Y"  THEN TP = 1
  190. 1900  RETURN 
  191. 1910  IF TP <2  THEN  RETURN 
  192. 1920 PL = 1
  193. 1930 XL = 0:XH = 0:YL = 0:YH = 0
  194. 1940 PF = 1: GOSUB 1970
  195. 1950  GOSUB 2330
  196. 1960 PF = 0
  197. 1970 XV = 0:YV = 0:PM = 0:OM = 0:PA = 0:OA = 0:AR = 0
  198. 1980  IF SP  THEN  GOSUB 2390
  199. 1990  FOR T = 1 TO TP -1
  200. 2000 RA = D(T) +(M(T)/60) +(S(T)/3600)
  201. 2010  IF Q(T) = 2  THEN RA = 180 -RA
  202. 2020  IF Q(T) = 3  THEN RA = 180 +RA
  203. 2030  IF Q(T) = 4  THEN RA = 360 -RA
  204. 2040 RA = RA/F
  205. 2050 X = L(T) *( SIN(RA)):Y = L(T) *( COS(RA))
  206. 2060 XV = XV +X:YV = YV +Y
  207. 2070 PM =  SQR((XV *XV) +(YV *YV))
  208. 2080  IF YV = 0  THEN YV = 1E -30
  209. 2090 PA = ( ATN(XV/YV) *F)
  210. 2100  IF PA <0  THEN PA = 180 +PA
  211. 2110  IF XV <0  THEN PA = 180 +PA
  212. 2120 AR = AR +((PM *OM * SIN((OA -PA)/F))/2)
  213. 2130 OA = PA:OM = PM
  214. 2140  IF CR  THEN  RETURN 
  215. 2150  IF PF  THEN  GOSUB 2280
  216. 2160  IF   NOT PF  THEN  GOSUB 2390
  217. 2170  NEXT T
  218. 2180  IF PF  THEN  RETURN 
  219. 2190  HOME : VTAB (21)
  220. 2200  PRINT "Closure Error: X=";XV;" Y=";YV
  221. 2210 A =  ABS(AR)
  222. 2220 B = A/43560
  223. 2230 A = ( INT((A *100) +.5))/100
  224. 2240 B = ( INT((B *100) +.5))/100
  225. 2250  PRINT "Area ";A;" Sq. Ft.   ";B;" Acres."
  226. 2260  INPUT "Small Square = Beginning Point (Press RETURN):";L$
  227. 2270  RETURN 
  228. 2280  IF XH <XV  THEN XH = XV
  229. 2290  IF XL >XV  THEN XL = XV
  230. 2300  IF YH <YV  THEN YH = YV
  231. 2310  IF YL >YV  THEN YL = YV
  232. 2320  RETURN 
  233. 2330 XF = (XH +XL)/2:YF = (YH +YL)/2
  234. 2340 XS =  ABS(XH) + ABS(XL):YS =  ABS(YH) + ABS(YL)
  235. 2350 SC = 150/YS
  236. 2360  IF XS >(YS *1.75)  THEN SC = 270/XS
  237. 2370  HGR : HCOLOR= 3
  238. 2380 SP = 1: RETURN 
  239. 2390 XP = 140 +((XV -XF) *SC):YP = 80 -((YV -YF) *SC)
  240. 2400  IF SP  THEN 2430
  241. 2410  HPLOT  TO XP,YP
  242. 2420  RETURN 
  243. 2430 SP = 0
  244. 2440  HPLOT XP +3,YP +3 TO XP +3,YP -3 TO XP -3,YP -3 TO XP -3,YP +3 TO XP +3,YP +3
  245. 2450  HPLOT XP,YP
  246. 2460  RETURN 
  247. 2470  PRINT : IF PL  THEN 2500
  248. 2480  INPUT "You must (P)lot before (A)djusting (press RETURN):";L$
  249. 2490  RETURN 
  250. 2500  INPUT "Adjust which line:";L$
  251. 2510  IF L$ = ""  THEN  RETURN 
  252. 2520 T =  VAL(L$)
  253. 2530  IF T <1  OR T >TP -1  THEN  RETURN 
  254. 2540 XV =  -XV:YV =  -YV
  255. 2550 CR = 1: GOSUB 2000
  256. 2560 CR = 0
  257. 2570 QI = 1 +( INT(PA/90))
  258. 2580  IF PA >180  THEN PA = 360 -PA
  259. 2590  IF PA >90  THEN PA = 180 -PA
  260. 2600 PA = PA +1.38889E -4
  261. 2610 PM = ( INT((PM *100) +.5))/100
  262. 2620 DI =  INT(PA):MI = (PA -DI) *60
  263. 2630 SI =  INT((MI -( INT(MI))) *60)
  264. 2640 MI =  INT(MI)
  265. 2650 Q(T) = QI:D(T) = DI:M(T) = MI:S(T) = SI:L(T) = PM
  266. 2660  RETURN